home *** CD-ROM | disk | FTP | other *** search
/ PC Open 102 / PC Open 102 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / $_1_ / HTTP / Request.pm < prev    next >
Encoding:
Perl POD Document  |  2004-02-03  |  4.7 KB  |  193 lines
  1. package HTTP::Request;
  2.  
  3. # $Id: Request.pm,v 1.34 2003/10/24 10:25:16 gisle Exp $
  4.  
  5. require HTTP::Message;
  6. @ISA = qw(HTTP::Message);
  7. $VERSION = sprintf("%d.%02d", q$Revision: 1.34 $ =~ /(\d+)\.(\d+)/);
  8.  
  9. use strict;
  10.  
  11.  
  12.  
  13. sub new
  14. {
  15.     my($class, $method, $uri, $header, $content) = @_;
  16.     my $self = $class->SUPER::new($header, $content);
  17.     $self->method($method);
  18.     $self->uri($uri);
  19.     $self;
  20. }
  21.  
  22.  
  23. sub clone
  24. {
  25.     my $self = shift;
  26.     my $clone = bless $self->SUPER::clone, ref($self);
  27.     $clone->method($self->method);
  28.     $clone->uri($self->uri);
  29.     $clone;
  30. }
  31.  
  32.  
  33. sub method
  34. {
  35.     shift->_elem('_method', @_);
  36. }
  37.  
  38.  
  39. sub uri
  40. {
  41.     my $self = shift;
  42.     my $old = $self->{'_uri'};
  43.     if (@_) {
  44.     my $uri = shift;
  45.     if (!defined $uri) {
  46.         # that's ok
  47.     }
  48.     elsif (ref $uri) {
  49.         Carp::croak("A URI can't be a " . ref($uri) . " reference")
  50.         if ref($uri) eq 'HASH' or ref($uri) eq 'ARRAY';
  51.         Carp::croak("Can't use a " . ref($uri) . " object as a URI")
  52.         unless $uri->can('scheme');
  53.         $uri = $uri->clone;
  54.         unless ($HTTP::URI_CLASS eq "URI") {
  55.         # Argh!! Hate this... old LWP legacy!
  56.         eval { local $SIG{__DIE__}; $uri = $uri->abs; };
  57.         die $@ if $@ && $@ !~ /Missing base argument/;
  58.         }
  59.     }
  60.     else {
  61.         $uri = $HTTP::URI_CLASS->new($uri);
  62.     }
  63.     $self->{'_uri'} = $uri;
  64.     }
  65.     $old;
  66. }
  67.  
  68. *url = \&uri;  # legacy
  69.  
  70.  
  71. sub as_string
  72. {
  73.     my $self = shift;
  74.     my @result;
  75.     #push(@result, "---- $self -----");
  76.     my $req_line = $self->method || "[NO METHOD]";
  77.     my $uri = $self->uri;
  78.     $uri = (defined $uri) ? $uri->as_string : "[NO URI]";
  79.     $req_line .= " $uri";
  80.     my $proto = $self->protocol;
  81.     $req_line .= " $proto" if $proto;
  82.  
  83.     push(@result, $req_line);
  84.     push(@result, $self->headers_as_string);
  85.     my $content = $self->content;
  86.     if (defined $content) {
  87.     push(@result, $content);
  88.     }
  89.     #push(@result, ("-" x 40));
  90.     join("\n", @result, "");
  91. }
  92.  
  93.  
  94. 1;
  95.  
  96. __END__
  97.  
  98. =head1 NAME
  99.  
  100. HTTP::Request - HTTP style request message
  101.  
  102. =head1 SYNOPSIS
  103.  
  104.  require HTTP::Request;
  105.  $request = HTTP::Request->new(GET => 'http://www.example.com/');
  106.  
  107. and usually used like this:
  108.  
  109.  $ua = LWP::UserAgent->new;
  110.  $response = $ua->request($request);
  111.  
  112. =head1 DESCRIPTION
  113.  
  114. C<HTTP::Request> is a class encapsulating HTTP style requests,
  115. consisting of a request line, some headers, and a content body. Note
  116. that the LWP library uses HTTP style requests even for non-HTTP
  117. protocols.  Instances of this class are usually passed to the
  118. request() method of an C<LWP::UserAgent> object.
  119.  
  120. C<HTTP::Request> is a subclass of C<HTTP::Message> and therefore
  121. inherits its methods.  The following additional methods are available:
  122.  
  123. =over 4
  124.  
  125. =item $r = HTTP::Request->new( $method, $uri )
  126.  
  127. =item $r = HTTP::Request->new( $method, $uri, $header )
  128.  
  129. =item $r = HTTP::Request->new( $method, $uri, $header, $content )
  130.  
  131. Constructs a new C<HTTP::Request> object describing a request on the
  132. object $uri using method $method.  The $method argument must be a
  133. string.  The $uri argument can be either a string, or a reference
  134. to a C<URI> object.  The optional $header argument should be a
  135. reference to an C<HTTP::Headers> object.  The optional $content
  136. argument should be a string of bytes.
  137.  
  138. =item $r->method
  139.  
  140. =item $r->method( $val )
  141.  
  142. This is used to get/set the method attribute.  The method should be a
  143. short string like "GET", "HEAD", "PUT" or "POST".
  144.  
  145. =item $r->uri
  146.  
  147. =item $r->uri( $val )
  148.  
  149. This is used to get/set the uri attribute.  The $val can be a
  150. reference to a URI object or a plain string.  If a string is given,
  151. then it should be parseable as an absolute URI.
  152.  
  153. =item $r->header( $field )
  154.  
  155. =item $r->header( $field => $value )
  156.  
  157. This is used to get/set header values and it is inherited from
  158. C<HTTP::Headers> via C<HTTP::Message>.  See L<HTTP::Headers> for
  159. details and other similar methods that can be used to access the
  160. headers.
  161.  
  162. =item $r->content
  163.  
  164. =item $r->content( $content )
  165.  
  166. This is used to get/set the content and it is inherited from the
  167. C<HTTP::Message> base class.  See L<HTTP::Message> for details and
  168. other methods that can be used to access the content.
  169.  
  170. Note that the content should be a string of bytes.  Strings in perl
  171. can contain characters outside the range of a byte.  The C<Encode>
  172. module can be used to turn such strings into a string of bytes.
  173.  
  174. =item $r->as_string
  175.  
  176. Method returning a textual representation of the request.
  177. Mainly useful for debugging purposes. It takes no arguments.
  178.  
  179. =back
  180.  
  181. =head1 SEE ALSO
  182.  
  183. L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Request::Common>,
  184. L<HTTP::Response>
  185.  
  186. =head1 COPYRIGHT
  187.  
  188. Copyright 1995-2001 Gisle Aas.
  189.  
  190. This library is free software; you can redistribute it and/or
  191. modify it under the same terms as Perl itself.
  192.  
  193.